home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / tcltk / tk8.4 / tkfbox.tcl < prev    next >
Text File  |  2009-04-29  |  50KB  |  1,816 lines

  1. # tkfbox.tcl --
  2. #
  3. #    Implements the "TK" standard file selection dialog box. This
  4. #    dialog box is used on the Unix platforms whenever the tk_strictMotif
  5. #    flag is not set.
  6. #
  7. #    The "TK" standard file selection dialog box is similar to the
  8. #    file selection dialog box on Win95(TM). The user can navigate
  9. #    the directories by clicking on the folder icons or by
  10. #    selecting the "Directory" option menu. The user can select
  11. #    files by clicking on the file icons or by entering a filename
  12. #    in the "Filename:" entry.
  13. #
  14. # RCS: @(#) $Id: tkfbox.tcl,v 1.38.2.13 2007/02/19 23:53:36 hobbs Exp $
  15. #
  16. # Copyright (c) 1994-1998 Sun Microsystems, Inc.
  17. #
  18. # See the file "license.terms" for information on usage and redistribution
  19. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  20. #
  21.  
  22. #----------------------------------------------------------------------
  23. #
  24. #              I C O N   L I S T
  25. #
  26. # This is a pseudo-widget that implements the icon list inside the 
  27. # ::tk::dialog::file:: dialog box.
  28. #
  29. #----------------------------------------------------------------------
  30.  
  31. # ::tk::IconList --
  32. #
  33. #    Creates an IconList widget.
  34. #
  35. proc ::tk::IconList {w args} {
  36.     IconList_Config $w $args
  37.     IconList_Create $w
  38. }
  39.  
  40. proc ::tk::IconList_Index {w i} {
  41.     upvar #0 ::tk::$w data
  42.     upvar #0 ::tk::$w:itemList itemList
  43.     if {![info exists data(list)]} {set data(list) {}}
  44.     switch -regexp -- $i {
  45.     "^-?[0-9]+$" {
  46.         if { $i < 0 } {
  47.         set i 0
  48.         }
  49.         if { $i >= [llength $data(list)] } {
  50.         set i [expr {[llength $data(list)] - 1}]
  51.         }
  52.         return $i
  53.     }
  54.     "^active$" {
  55.         return $data(index,active)
  56.     }
  57.     "^anchor$" {
  58.         return $data(index,anchor)
  59.     }
  60.     "^end$" {
  61.         return [llength $data(list)]
  62.     }
  63.     "@-?[0-9]+,-?[0-9]+" {
  64.         foreach {x y} [scan $i "@%d,%d"] {
  65.         break
  66.         }
  67.         set item [$data(canvas) find closest $x $y]
  68.         return [lindex [$data(canvas) itemcget $item -tags] 1]
  69.     }
  70.     }
  71. }
  72.  
  73. proc ::tk::IconList_Selection {w op args} {
  74.     upvar ::tk::$w data
  75.     switch -exact -- $op {
  76.     "anchor" {
  77.         if { [llength $args] == 1 } {
  78.         set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]]
  79.         } else {
  80.         return $data(index,anchor)
  81.         }
  82.     }
  83.     "clear" {
  84.         if { [llength $args] == 2 } {
  85.         foreach {first last} $args {
  86.             break
  87.         }
  88.         } elseif { [llength $args] == 1 } {
  89.         set first [set last [lindex $args 0]]
  90.         } else {
  91.         error "wrong # args: should be [lindex [info level 0] 0] path\
  92.             clear first ?last?"
  93.         }
  94.         set first [IconList_Index $w $first]
  95.         set last [IconList_Index $w $last]
  96.         if { $first > $last } {
  97.         set tmp $first
  98.         set first $last
  99.         set last $tmp
  100.         }
  101.         set ind 0
  102.         foreach item $data(selection) {
  103.         if { $item >= $first } {
  104.             set first $ind
  105.             break
  106.         }
  107.         }
  108.         set ind [expr {[llength $data(selection)] - 1}]
  109.         for {} {$ind >= 0} {incr ind -1} {
  110.         set item [lindex $data(selection) $ind]
  111.         if { $item <= $last } {
  112.             set last $ind
  113.             break
  114.         }
  115.         }
  116.  
  117.         if { $first > $last } {
  118.         return
  119.         }
  120.         set data(selection) [lreplace $data(selection) $first $last]
  121.         event generate $w <<ListboxSelect>>
  122.         IconList_DrawSelection $w
  123.     }
  124.     "includes" {
  125.         set index [lsearch -exact $data(selection) [lindex $args 0]]
  126.         return [expr {$index != -1}]
  127.     }
  128.     "set" {
  129.         if { [llength $args] == 2 } {
  130.         foreach {first last} $args {
  131.             break
  132.         }
  133.         } elseif { [llength $args] == 1 } {
  134.         set last [set first [lindex $args 0]]
  135.         } else {
  136.         error "wrong # args: should be [lindex [info level 0] 0] path\
  137.             set first ?last?"
  138.         }
  139.  
  140.         set first [IconList_Index $w $first]
  141.         set last [IconList_Index $w $last]
  142.         if { $first > $last } {
  143.         set tmp $first
  144.         set first $last
  145.         set last $tmp
  146.         }
  147.         for {set i $first} {$i <= $last} {incr i} {
  148.         lappend data(selection) $i
  149.         }
  150.         set data(selection) [lsort -integer -unique $data(selection)]
  151.         event generate $w <<ListboxSelect>>
  152.         IconList_DrawSelection $w
  153.     }
  154.     }
  155. }
  156.  
  157. proc ::tk::IconList_Curselection {w} {
  158.     upvar ::tk::$w data
  159.     return $data(selection)
  160. }
  161.  
  162. proc ::tk::IconList_DrawSelection {w} {
  163.     upvar ::tk::$w data
  164.     upvar ::tk::$w:itemList itemList
  165.  
  166.     $data(canvas) delete selection
  167.     foreach item $data(selection) {
  168.     set rTag [lindex [lindex $data(list) $item] 2]
  169.     foreach {iTag tTag text serial} $itemList($rTag) {
  170.         break
  171.     }
  172.  
  173.     set bbox [$data(canvas) bbox $tTag]
  174.         $data(canvas) create rect $bbox -fill \#a0a0ff -outline \#a0a0ff \
  175.         -tags selection
  176.     }
  177.     $data(canvas) lower selection
  178.     return
  179. }
  180.  
  181. proc ::tk::IconList_Get {w item} {
  182.     upvar ::tk::$w data
  183.     upvar ::tk::$w:itemList itemList
  184.     set rTag [lindex [lindex $data(list) $item] 2]
  185.     foreach {iTag tTag text serial} $itemList($rTag) {
  186.     break
  187.     }
  188.     return $text
  189. }
  190.  
  191. # ::tk::IconList_Config --
  192. #
  193. #    Configure the widget variables of IconList, according to the command
  194. #    line arguments.
  195. #
  196. proc ::tk::IconList_Config {w argList} {
  197.  
  198.     # 1: the configuration specs
  199.     #
  200.     set specs {
  201.     {-command "" "" ""}
  202.     {-multiple "" "" "0"}
  203.     }
  204.  
  205.     # 2: parse the arguments
  206.     #
  207.     tclParseConfigSpec ::tk::$w $specs "" $argList
  208. }
  209.  
  210. # ::tk::IconList_Create --
  211. #
  212. #    Creates an IconList widget by assembling a canvas widget and a
  213. #    scrollbar widget. Sets all the bindings necessary for the IconList's
  214. #    operations.
  215. #
  216. proc ::tk::IconList_Create {w} {
  217.     upvar ::tk::$w data
  218.  
  219.     frame $w
  220.     set data(sbar)   [scrollbar $w.sbar -orient horizontal -takefocus 0]
  221.     catch {$data(sbar) configure -highlightthickness 0}
  222.     set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \
  223.         -width 400 -height 120 -takefocus 1]
  224.     pack $data(sbar) -side bottom -fill x -padx 2
  225.     pack $data(canvas) -expand yes -fill both
  226.  
  227.     $data(sbar) configure -command [list $data(canvas) xview]
  228.     $data(canvas) configure -xscrollcommand [list $data(sbar) set]
  229.  
  230.     # Initializes the max icon/text width and height and other variables
  231.     #
  232.     set data(maxIW) 1
  233.     set data(maxIH) 1
  234.     set data(maxTW) 1
  235.     set data(maxTH) 1
  236.     set data(numItems) 0
  237.     set data(curItem)  {}
  238.     set data(noScroll) 1
  239.     set data(selection) {}
  240.     set data(index,anchor) ""
  241.     set fg [option get $data(canvas) foreground Foreground]
  242.     if {$fg eq ""} {
  243.     set data(fill) black
  244.     } else {
  245.     set data(fill) $fg
  246.     }
  247.  
  248.     # Creates the event bindings.
  249.     #
  250.     bind $data(canvas) <Configure>    [list tk::IconList_Arrange $w]
  251.  
  252.     bind $data(canvas) <1>        [list tk::IconList_Btn1 $w %x %y]
  253.     bind $data(canvas) <B1-Motion>    [list tk::IconList_Motion1 $w %x %y]
  254.     bind $data(canvas) <B1-Leave>    [list tk::IconList_Leave1 $w %x %y]
  255.     bind $data(canvas) <Control-1>    [list tk::IconList_CtrlBtn1 $w %x %y]
  256.     bind $data(canvas) <Shift-1>    [list tk::IconList_ShiftBtn1 $w %x %y]
  257.     bind $data(canvas) <B1-Enter>    [list tk::CancelRepeat]
  258.     bind $data(canvas) <ButtonRelease-1> [list tk::CancelRepeat]
  259.     bind $data(canvas) <Double-ButtonRelease-1> \
  260.         [list tk::IconList_Double1 $w %x %y]
  261.  
  262.     bind $data(canvas) <Up>        [list tk::IconList_UpDown $w -1]
  263.     bind $data(canvas) <Down>        [list tk::IconList_UpDown $w  1]
  264.     bind $data(canvas) <Left>        [list tk::IconList_LeftRight $w -1]
  265.     bind $data(canvas) <Right>        [list tk::IconList_LeftRight $w  1]
  266.     bind $data(canvas) <Return>        [list tk::IconList_ReturnKey $w]
  267.     bind $data(canvas) <KeyPress>    [list tk::IconList_KeyPress $w %A]
  268.     bind $data(canvas) <Control-KeyPress> ";"
  269.     bind $data(canvas) <Alt-KeyPress>    ";"
  270.  
  271.     bind $data(canvas) <FocusIn>    [list tk::IconList_FocusIn $w]
  272.     bind $data(canvas) <FocusOut>    [list tk::IconList_FocusOut $w]
  273.  
  274.     return $w
  275. }
  276.  
  277. # ::tk::IconList_AutoScan --
  278. #
  279. # This procedure is invoked when the mouse leaves an entry window
  280. # with button 1 down.  It scrolls the window up, down, left, or
  281. # right, depending on where the mouse left the window, and reschedules
  282. # itself as an "after" command so that the window continues to scroll until
  283. # the mouse moves back into the window or the mouse button is released.
  284. #
  285. # Arguments:
  286. # w -        The IconList window.
  287. #
  288. proc ::tk::IconList_AutoScan {w} {
  289.     upvar ::tk::$w data
  290.     variable ::tk::Priv
  291.  
  292.     if {![winfo exists $w]} return
  293.     set x $Priv(x)
  294.     set y $Priv(y)
  295.  
  296.     if {$data(noScroll)} {
  297.     return
  298.     }
  299.     if {$x >= [winfo width $data(canvas)]} {
  300.     $data(canvas) xview scroll 1 units
  301.     } elseif {$x < 0} {
  302.     $data(canvas) xview scroll -1 units
  303.     } elseif {$y >= [winfo height $data(canvas)]} {
  304.     # do nothing
  305.     } elseif {$y < 0} {
  306.     # do nothing
  307.     } else {
  308.     return
  309.     }
  310.  
  311.     IconList_Motion1 $w $x $y
  312.     set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]]
  313. }
  314.  
  315. # Deletes all the items inside the canvas subwidget and reset the IconList's
  316. # state.
  317. #
  318. proc ::tk::IconList_DeleteAll {w} {
  319.     upvar ::tk::$w data
  320.     upvar ::tk::$w:itemList itemList
  321.  
  322.     $data(canvas) delete all
  323.     unset -nocomplain data(selected) data(rect) data(list) itemList
  324.     set data(maxIW) 1
  325.     set data(maxIH) 1
  326.     set data(maxTW) 1
  327.     set data(maxTH) 1
  328.     set data(numItems) 0
  329.     set data(curItem)  {}
  330.     set data(noScroll) 1
  331.     set data(selection) {}
  332.     set data(index,anchor) ""
  333.     $data(sbar) set 0.0 1.0
  334.     $data(canvas) xview moveto 0
  335. }
  336.  
  337. # Adds an icon into the IconList with the designated image and text
  338. #
  339. proc ::tk::IconList_Add {w image items} {
  340.     upvar ::tk::$w data
  341.     upvar ::tk::$w:itemList itemList
  342.     upvar ::tk::$w:textList textList
  343.  
  344.     foreach text $items {
  345.     set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \
  346.         -tags [list icon $data(numItems) item$data(numItems)]]
  347.     set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \
  348.         -font $data(font) -fill $data(fill) \
  349.         -tags [list text $data(numItems) item$data(numItems)]]
  350.     set rTag [$data(canvas) create rect  0 0 0 0 -fill "" -outline "" \
  351.         -tags [list rect $data(numItems) item$data(numItems)]]
  352.     
  353.     foreach {x1 y1 x2 y2} [$data(canvas) bbox $iTag] {
  354.         break
  355.     }
  356.     set iW [expr {$x2 - $x1}]
  357.     set iH [expr {$y2 - $y1}]
  358.     if {$data(maxIW) < $iW} {
  359.         set data(maxIW) $iW
  360.     }
  361.     if {$data(maxIH) < $iH} {
  362.         set data(maxIH) $iH
  363.     }
  364.     
  365.     foreach {x1 y1 x2 y2} [$data(canvas) bbox $tTag] {
  366.         break
  367.     }
  368.     set tW [expr {$x2 - $x1}]
  369.     set tH [expr {$y2 - $y1}]
  370.     if {$data(maxTW) < $tW} {
  371.         set data(maxTW) $tW
  372.     }
  373.     if {$data(maxTH) < $tH} {
  374.         set data(maxTH) $tH
  375.     }
  376.     
  377.     lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW \
  378.         $tH $data(numItems)]
  379.     set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
  380.     set textList($data(numItems)) [string tolower $text]
  381.     incr data(numItems)
  382.     }
  383. }
  384.  
  385. # Places the icons in a column-major arrangement.
  386. #
  387. proc ::tk::IconList_Arrange {w} {
  388.     upvar ::tk::$w data
  389.  
  390.     if {![info exists data(list)]} {
  391.     if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {
  392.         set data(noScroll) 1
  393.         $data(sbar) configure -command ""
  394.     }
  395.     return
  396.     }
  397.  
  398.     set W [winfo width  $data(canvas)]
  399.     set H [winfo height $data(canvas)]
  400.     set pad [expr {[$data(canvas) cget -highlightthickness] + \
  401.         [$data(canvas) cget -bd]}]
  402.     if {$pad < 2} {
  403.     set pad 2
  404.     }
  405.  
  406.     incr W -[expr {$pad*2}]
  407.     incr H -[expr {$pad*2}]
  408.  
  409.     set dx [expr {$data(maxIW) + $data(maxTW) + 8}]
  410.     if {$data(maxTH) > $data(maxIH)} {
  411.     set dy $data(maxTH)
  412.     } else {
  413.     set dy $data(maxIH)
  414.     }
  415.     incr dy 2
  416.     set shift [expr {$data(maxIW) + 4}]
  417.  
  418.     set x [expr {$pad * 2}]
  419.     set y [expr {$pad * 1}] ; # Why * 1 ?
  420.     set usedColumn 0
  421.     foreach sublist $data(list) {
  422.     set usedColumn 1
  423.     foreach {iTag tTag rTag iW iH tW tH} $sublist {
  424.         break
  425.     }
  426.  
  427.     set i_dy [expr {($dy - $iH)/2}]
  428.     set t_dy [expr {($dy - $tH)/2}]
  429.  
  430.     $data(canvas) coords $iTag $x                    [expr {$y + $i_dy}]
  431.     $data(canvas) coords $tTag [expr {$x + $shift}]  [expr {$y + $t_dy}]
  432.     $data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
  433.  
  434.     incr y $dy
  435.     if {($y + $dy) > $H} {
  436.         set y [expr {$pad * 1}] ; # *1 ?
  437.         incr x $dx
  438.         set usedColumn 0
  439.     }
  440.     }
  441.  
  442.     if {$usedColumn} {
  443.     set sW [expr {$x + $dx}]
  444.     } else {
  445.     set sW $x
  446.     }
  447.  
  448.     if {$sW < $W} {
  449.     $data(canvas) configure -scrollregion [list $pad $pad $sW $H]
  450.     $data(sbar) configure -command ""
  451.     $data(canvas) xview moveto 0
  452.     set data(noScroll) 1
  453.     } else {
  454.     $data(canvas) configure -scrollregion [list $pad $pad $sW $H]
  455.     $data(sbar) configure -command [list $data(canvas) xview]
  456.     set data(noScroll) 0
  457.     }
  458.  
  459.     set data(itemsPerColumn) [expr {($H-$pad)/$dy}]
  460.     if {$data(itemsPerColumn) < 1} {
  461.     set data(itemsPerColumn) 1
  462.     }
  463.  
  464.     if {$data(curItem) ne ""} {
  465.     IconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0
  466.     }
  467. }
  468.  
  469. # Gets called when the user invokes the IconList (usually by double-clicking
  470. # or pressing the Return key).
  471. #
  472. proc ::tk::IconList_Invoke {w} {
  473.     upvar ::tk::$w data
  474.  
  475.     if {$data(-command) ne "" && [llength $data(selection)]} {
  476.     uplevel #0 $data(-command)
  477.     }
  478. }
  479.  
  480. # ::tk::IconList_See --
  481. #
  482. #    If the item is not (completely) visible, scroll the canvas so that
  483. #    it becomes visible.
  484. proc ::tk::IconList_See {w rTag} {
  485.     upvar ::tk::$w data
  486.     upvar ::tk::$w:itemList itemList
  487.  
  488.     if {$data(noScroll)} {
  489.     return
  490.     }
  491.     set sRegion [$data(canvas) cget -scrollregion]
  492.     if {$sRegion eq ""} {
  493.     return
  494.     }
  495.  
  496.     if { $rTag < 0 || $rTag >= [llength $data(list)] } {
  497.     return
  498.     }
  499.  
  500.     set bbox [$data(canvas) bbox item$rTag]
  501.     set pad [expr {[$data(canvas) cget -highlightthickness] + \
  502.         [$data(canvas) cget -bd]}]
  503.  
  504.     set x1 [lindex $bbox 0]
  505.     set x2 [lindex $bbox 2]
  506.     incr x1 -[expr {$pad * 2}]
  507.     incr x2 -[expr {$pad * 1}] ; # *1 ?
  508.  
  509.     set cW [expr {[winfo width $data(canvas)] - $pad*2}]
  510.  
  511.     set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
  512.     set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]
  513.     set oldDispX $dispX
  514.  
  515.     # check if out of the right edge
  516.     #
  517.     if {($x2 - $dispX) >= $cW} {
  518.     set dispX [expr {$x2 - $cW}]
  519.     }
  520.     # check if out of the left edge
  521.     #
  522.     if {($x1 - $dispX) < 0} {
  523.     set dispX $x1
  524.     }
  525.  
  526.     if {$oldDispX ne $dispX} {
  527.     set fraction [expr {double($dispX)/double($scrollW)}]
  528.     $data(canvas) xview moveto $fraction
  529.     }
  530. }
  531.  
  532. proc ::tk::IconList_Btn1 {w x y} {
  533.     upvar ::tk::$w data
  534.  
  535.     focus $data(canvas)
  536.     set x [expr {int([$data(canvas) canvasx $x])}]
  537.     set y [expr {int([$data(canvas) canvasy $y])}]
  538.     set i [IconList_Index $w @${x},${y}]
  539.     if {$i eq ""} return
  540.     IconList_Selection $w clear 0 end
  541.     IconList_Selection $w set $i
  542.     IconList_Selection $w anchor $i
  543. }
  544.  
  545. proc ::tk::IconList_CtrlBtn1 {w x y} {
  546.     upvar ::tk::$w data
  547.     
  548.     if { $data(-multiple) } {
  549.     focus $data(canvas)
  550.     set x [expr {int([$data(canvas) canvasx $x])}]
  551.     set y [expr {int([$data(canvas) canvasy $y])}]
  552.     set i [IconList_Index $w @${x},${y}]
  553.     if {$i eq ""} return
  554.     if { [IconList_Selection $w includes $i] } {
  555.         IconList_Selection $w clear $i
  556.     } else {
  557.         IconList_Selection $w set $i
  558.         IconList_Selection $w anchor $i
  559.     }
  560.     }
  561. }
  562.  
  563. proc ::tk::IconList_ShiftBtn1 {w x y} {
  564.     upvar ::tk::$w data
  565.     
  566.     if { $data(-multiple) } {
  567.     focus $data(canvas)
  568.     set x [expr {int([$data(canvas) canvasx $x])}]
  569.     set y [expr {int([$data(canvas) canvasy $y])}]
  570.     set i [IconList_Index $w @${x},${y}]
  571.     if {$i eq ""} return
  572.     set a [IconList_Index $w anchor]
  573.     if { $a eq "" } {
  574.         set a $i
  575.     }
  576.     IconList_Selection $w clear 0 end
  577.     IconList_Selection $w set $a $i
  578.     }
  579. }
  580.  
  581. # Gets called on button-1 motions
  582. #
  583. proc ::tk::IconList_Motion1 {w x y} {
  584.     upvar ::tk::$w data
  585.     variable ::tk::Priv
  586.     set Priv(x) $x
  587.     set Priv(y) $y
  588.     set x [expr {int([$data(canvas) canvasx $x])}]
  589.     set y [expr {int([$data(canvas) canvasy $y])}]
  590.     set i [IconList_Index $w @${x},${y}]
  591.     if {$i eq ""} return
  592.     IconList_Selection $w clear 0 end
  593.     IconList_Selection $w set $i
  594. }
  595.  
  596. proc ::tk::IconList_Double1 {w x y} {
  597.     upvar ::tk::$w data
  598.  
  599.     if {[llength $data(selection)]} {
  600.     IconList_Invoke $w
  601.     }
  602. }
  603.  
  604. proc ::tk::IconList_ReturnKey {w} {
  605.     IconList_Invoke $w
  606. }
  607.  
  608. proc ::tk::IconList_Leave1 {w x y} {
  609.     variable ::tk::Priv
  610.  
  611.     set Priv(x) $x
  612.     set Priv(y) $y
  613.     IconList_AutoScan $w
  614. }
  615.  
  616. proc ::tk::IconList_FocusIn {w} {
  617.     upvar ::tk::$w data
  618.  
  619.     if {![info exists data(list)]} {
  620.     return
  621.     }
  622.  
  623.     if {[llength $data(selection)]} {
  624.     IconList_DrawSelection $w
  625.     }
  626. }
  627.  
  628. proc ::tk::IconList_FocusOut {w} {
  629.     IconList_Selection $w clear 0 end
  630. }
  631.  
  632. # ::tk::IconList_UpDown --
  633. #
  634. # Moves the active element up or down by one element
  635. #
  636. # Arguments:
  637. # w -        The IconList widget.
  638. # amount -    +1 to move down one item, -1 to move back one item.
  639. #
  640. proc ::tk::IconList_UpDown {w amount} {
  641.     upvar ::tk::$w data
  642.  
  643.     if {![info exists data(list)]} {
  644.     return
  645.     }
  646.  
  647.     set curr [tk::IconList_Curselection $w]
  648.     if { [llength $curr] == 0 } {
  649.     set i 0
  650.     } else {
  651.     set i [tk::IconList_Index $w anchor]
  652.     if {$i eq ""} return
  653.     incr i $amount
  654.     }
  655.     IconList_Selection $w clear 0 end
  656.     IconList_Selection $w set $i
  657.     IconList_Selection $w anchor $i
  658.     IconList_See $w $i
  659. }
  660.  
  661. # ::tk::IconList_LeftRight --
  662. #
  663. # Moves the active element left or right by one column
  664. #
  665. # Arguments:
  666. # w -        The IconList widget.
  667. # amount -    +1 to move right one column, -1 to move left one column.
  668. #
  669. proc ::tk::IconList_LeftRight {w amount} {
  670.     upvar ::tk::$w data
  671.  
  672.     if {![info exists data(list)]} {
  673.     return
  674.     }
  675.  
  676.     set curr [IconList_Curselection $w]
  677.     if { [llength $curr] == 0 } {
  678.     set i 0
  679.     } else {
  680.     set i [IconList_Index $w anchor]
  681.     if {$i eq ""} return
  682.     incr i [expr {$amount*$data(itemsPerColumn)}]
  683.     }
  684.     IconList_Selection $w clear 0 end
  685.     IconList_Selection $w set $i
  686.     IconList_Selection $w anchor $i
  687.     IconList_See $w $i
  688. }
  689.  
  690. #----------------------------------------------------------------------
  691. #        Accelerator key bindings
  692. #----------------------------------------------------------------------
  693.  
  694. # ::tk::IconList_KeyPress --
  695. #
  696. #    Gets called when user enters an arbitrary key in the listbox.
  697. #
  698. proc ::tk::IconList_KeyPress {w key} {
  699.     variable ::tk::Priv
  700.  
  701.     append Priv(ILAccel,$w) $key
  702.     IconList_Goto $w $Priv(ILAccel,$w)
  703.     catch {
  704.     after cancel $Priv(ILAccel,$w,afterId)
  705.     }
  706.     set Priv(ILAccel,$w,afterId) [after 500 [list tk::IconList_Reset $w]]
  707. }
  708.  
  709. proc ::tk::IconList_Goto {w text} {
  710.     upvar ::tk::$w data
  711.     upvar ::tk::$w:textList textList
  712.  
  713.     if {![info exists data(list)]} {
  714.     return
  715.     }
  716.  
  717.     if {$text eq "" || $data(numItems) == 0} {
  718.     return
  719.     }
  720.  
  721.     if {$data(curItem) eq "" || $data(curItem) == 0} {
  722.     set start  0
  723.     } else {
  724.     set start  $data(curItem)
  725.     }
  726.  
  727.     set text [string tolower $text]
  728.     set theIndex -1
  729.     set less 0
  730.     set len [string length $text]
  731.     set len0 [expr {$len-1}]
  732.     set i $start
  733.  
  734.     # Search forward until we find a filename whose prefix is an exact match
  735.     # with $text
  736.     while {1} {
  737.     set sub [string range $textList($i) 0 $len0]
  738.     if {$text eq $sub} {
  739.         set theIndex $i
  740.         break
  741.     }
  742.     incr i
  743.     if {$i == $data(numItems)} {
  744.         set i 0
  745.     }
  746.     if {$i == $start} {
  747.         break
  748.     }
  749.     }
  750.  
  751.     if {$theIndex > -1} {
  752.     IconList_Selection $w clear 0 end
  753.     IconList_Selection $w set $theIndex
  754.     IconList_Selection $w anchor $theIndex
  755.     IconList_See $w $theIndex
  756.     }
  757. }
  758.  
  759. proc ::tk::IconList_Reset {w} {
  760.     variable ::tk::Priv
  761.  
  762.     unset -nocomplain Priv(ILAccel,$w)
  763. }
  764.  
  765. #----------------------------------------------------------------------
  766. #
  767. #              F I L E   D I A L O G
  768. #
  769. #----------------------------------------------------------------------
  770.  
  771. namespace eval ::tk::dialog {}
  772. namespace eval ::tk::dialog::file {
  773.     namespace import -force ::tk::msgcat::*
  774.     set ::tk::dialog::file::showHiddenBtn 0
  775.     set ::tk::dialog::file::showHiddenVar 1
  776. }
  777.  
  778. # ::tk::dialog::file:: --
  779. #
  780. #    Implements the TK file selection dialog. This dialog is used when
  781. #    the tk_strictMotif flag is set to false. This procedure shouldn't
  782. #    be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
  783. #
  784. # Arguments:
  785. #    type        "open" or "save"
  786. #    args        Options parsed by the procedure.
  787. #
  788.  
  789. proc ::tk::dialog::file:: {type args} {
  790.     variable ::tk::Priv
  791.     set dataName __tk_filedialog
  792.     upvar ::tk::dialog::file::$dataName data
  793.  
  794.     ::tk::dialog::file::Config $dataName $type $args
  795.  
  796.     if {$data(-parent) eq "."} {
  797.         set w .$dataName
  798.     } else {
  799.         set w $data(-parent).$dataName
  800.     }
  801.  
  802.     # (re)create the dialog box if necessary
  803.     #
  804.     if {![winfo exists $w]} {
  805.     ::tk::dialog::file::Create $w TkFDialog
  806.     } elseif {[winfo class $w] ne "TkFDialog"} {
  807.     destroy $w
  808.     ::tk::dialog::file::Create $w TkFDialog
  809.     } else {
  810.     set data(dirMenuBtn) $w.f1.menu
  811.     set data(dirMenu) $w.f1.menu.menu
  812.     set data(upBtn) $w.f1.up
  813.     set data(icons) $w.icons
  814.     set data(ent) $w.f2.ent
  815.     set data(typeMenuLab) $w.f2.lab2
  816.     set data(typeMenuBtn) $w.f2.menu
  817.     set data(typeMenu) $data(typeMenuBtn).m
  818.     set data(okBtn) $w.f2.ok
  819.     set data(cancelBtn) $w.f2.cancel
  820.     set data(hiddenBtn) $w.f2.hidden
  821.     ::tk::dialog::file::SetSelectMode $w $data(-multiple)
  822.     }
  823.     if {$::tk::dialog::file::showHiddenBtn} {
  824.     $data(hiddenBtn) configure -state normal
  825.     grid $data(hiddenBtn)
  826.     } else {
  827.     $data(hiddenBtn) configure -state disabled
  828.     grid remove $data(hiddenBtn)
  829.     }
  830.  
  831.     # Make sure subseqent uses of this dialog are independent [Bug 845189]
  832.     unset -nocomplain data(extUsed)
  833.  
  834.     # Dialog boxes should be transient with respect to their parent,
  835.     # so that they will always stay on top of their parent window.  However,
  836.     # some window managers will create the window as withdrawn if the parent
  837.     # window is withdrawn or iconified.  Combined with the grab we put on the
  838.     # window, this can hang the entire application.  Therefore we only make
  839.     # the dialog transient if the parent is viewable.
  840.  
  841.     if {[winfo viewable [winfo toplevel $data(-parent)]]} {
  842.     wm transient $w $data(-parent)
  843.     }
  844.  
  845.     # Add traces on the selectPath variable
  846.     #
  847.  
  848.     trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
  849.     $data(dirMenuBtn) configure \
  850.         -textvariable ::tk::dialog::file::${dataName}(selectPath)
  851.  
  852.     # Initialize the file types menu
  853.     #
  854.     if {[llength $data(-filetypes)]} {
  855.     $data(typeMenu) delete 0 end
  856.     foreach type $data(-filetypes) {
  857.         set title  [lindex $type 0]
  858.         set filter [lindex $type 1]
  859.         $data(typeMenu) add command -label $title \
  860.         -command [list ::tk::dialog::file::SetFilter $w $type]
  861.     }
  862.     ::tk::dialog::file::SetFilter $w [lindex $data(-filetypes) 0]
  863.     $data(typeMenuBtn) configure -state normal
  864.     $data(typeMenuLab) configure -state normal
  865.     } else {
  866.     set data(filter) "*"
  867.     $data(typeMenuBtn) configure -state disabled -takefocus 0
  868.     $data(typeMenuLab) configure -state disabled
  869.     }
  870.     ::tk::dialog::file::UpdateWhenIdle $w
  871.  
  872.     # Withdraw the window, then update all the geometry information
  873.     # so we know how big it wants to be, then center the window in the
  874.     # display and de-iconify it.
  875.  
  876.     ::tk::PlaceWindow $w widget $data(-parent)
  877.     wm title $w $data(-title)
  878.  
  879.     # Set a grab and claim the focus too.
  880.  
  881.     ::tk::SetFocusGrab $w $data(ent)
  882.     $data(ent) delete 0 end
  883.     $data(ent) insert 0 $data(selectFile)
  884.     $data(ent) selection range 0 end
  885.     $data(ent) icursor end
  886.  
  887.     # Wait for the user to respond, then restore the focus and
  888.     # return the index of the selected button.  Restore the focus
  889.     # before deleting the window, since otherwise the window manager
  890.     # may take the focus away so we can't redirect it.  Finally,
  891.     # restore any grab that was in effect.
  892.  
  893.     vwait ::tk::Priv(selectFilePath)
  894.  
  895.     ::tk::RestoreFocusGrab $w $data(ent) withdraw
  896.  
  897.     # Cleanup traces on selectPath variable
  898.     #
  899.  
  900.     foreach trace [trace info variable data(selectPath)] {
  901.     trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
  902.     }
  903.     $data(dirMenuBtn) configure -textvariable {}
  904.  
  905.     return $Priv(selectFilePath)
  906. }
  907.  
  908. # ::tk::dialog::file::Config --
  909. #
  910. #    Configures the TK filedialog according to the argument list
  911. #
  912. proc ::tk::dialog::file::Config {dataName type argList} {
  913.     upvar ::tk::dialog::file::$dataName data
  914.  
  915.     set data(type) $type
  916.  
  917.     # 0: Delete all variable that were set on data(selectPath) the
  918.     # last time the file dialog is used. The traces may cause troubles
  919.     # if the dialog is now used with a different -parent option.
  920.  
  921.     foreach trace [trace info variable data(selectPath)] {
  922.     trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
  923.     }
  924.  
  925.     # 1: the configuration specs
  926.     #
  927.     set specs {
  928.     {-defaultextension "" "" ""}
  929.     {-filetypes "" "" ""}
  930.     {-initialdir "" "" ""}
  931.     {-initialfile "" "" ""}
  932.     {-parent "" "" "."}
  933.     {-title "" "" ""}
  934.     }
  935.  
  936.     # The "-multiple" option is only available for the "open" file dialog.
  937.     #
  938.     if { $type eq "open" } {
  939.     lappend specs {-multiple "" "" "0"}
  940.     }
  941.  
  942.     # 2: default values depending on the type of the dialog
  943.     #
  944.     if {![info exists data(selectPath)]} {
  945.     # first time the dialog has been popped up
  946.     set data(selectPath) [pwd]
  947.     set data(selectFile) ""
  948.     }
  949.  
  950.     # 3: parse the arguments
  951.     #
  952.     tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
  953.  
  954.     if {$data(-title) eq ""} {
  955.     if {$type eq "open"} {
  956.         set data(-title) "[mc "Open"]"
  957.     } else {
  958.         set data(-title) "[mc "Save As"]"
  959.     }
  960.     }
  961.  
  962.     # 4: set the default directory and selection according to the -initial
  963.     #    settings
  964.     #
  965.     if {$data(-initialdir) ne ""} {
  966.     # Ensure that initialdir is an absolute path name.
  967.     if {[file isdirectory $data(-initialdir)]} {
  968.         set old [pwd]
  969.         cd $data(-initialdir)
  970.         set data(selectPath) [pwd]
  971.         cd $old
  972.     } else {
  973.         set data(selectPath) [pwd]
  974.     }
  975.     }
  976.     set data(selectFile) $data(-initialfile)
  977.  
  978.     # 5. Parse the -filetypes option
  979.     #
  980.     set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]
  981.  
  982.     if {![winfo exists $data(-parent)]} {
  983.     error "bad window path name \"$data(-parent)\""
  984.     }
  985.  
  986.     # Set -multiple to a one or zero value (not other boolean types
  987.     # like "yes") so we can use it in tests more easily.
  988.     if {$type eq "save"} {
  989.     set data(-multiple) 0
  990.     } elseif {$data(-multiple)} { 
  991.     set data(-multiple) 1 
  992.     } else {
  993.     set data(-multiple) 0
  994.     }
  995. }
  996.  
  997. proc ::tk::dialog::file::Create {w class} {
  998.     set dataName [lindex [split $w .] end]
  999.     upvar ::tk::dialog::file::$dataName data
  1000.     variable ::tk::Priv
  1001.     global tk_library
  1002.  
  1003.     toplevel $w -class $class
  1004.  
  1005.     # f1: the frame with the directory option menu
  1006.     #
  1007.     set f1 [frame $w.f1]
  1008.     bind [::tk::AmpWidget label $f1.lab -text "[mc "&Directory:"]" ] \
  1009.     <<AltUnderlined>> [list focus $f1.menu]
  1010.     
  1011.     set data(dirMenuBtn) $f1.menu
  1012.     set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) ::tk::dialog::file::$dataName] ""]
  1013.     set data(upBtn) [button $f1.up]
  1014.     if {![info exists Priv(updirImage)]} {
  1015.     set Priv(updirImage) [image create bitmap -data {
  1016. #define updir_width 28
  1017. #define updir_height 16
  1018. static char updir_bits[] = {
  1019.    0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
  1020.    0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
  1021.    0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
  1022.    0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
  1023.    0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
  1024.    0xf0, 0xff, 0xff, 0x01};}]
  1025.     }
  1026.     $data(upBtn) configure -image $Priv(updirImage)
  1027.  
  1028.     $f1.menu configure -takefocus 1 -highlightthickness 2
  1029.  
  1030.     pack $data(upBtn) -side right -padx 4 -fill both
  1031.     pack $f1.lab -side left -padx 4 -fill both
  1032.     pack $f1.menu -expand yes -fill both -padx 4
  1033.  
  1034.     # data(icons): the IconList that list the files and directories.
  1035.     #
  1036.     if { $class eq "TkFDialog" } {
  1037.     if { $data(-multiple) } {
  1038.         set fNameCaption [mc "File &names:"]
  1039.     } else {
  1040.         set fNameCaption [mc "File &name:"]
  1041.     }
  1042.     set fTypeCaption [mc "Files of &type:"]
  1043.     set iconListCommand [list ::tk::dialog::file::OkCmd $w]
  1044.     } else {
  1045.     set fNameCaption [mc "&Selection:"]
  1046.     set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]
  1047.     }
  1048.     set data(icons) [::tk::IconList $w.icons \
  1049.         -command    $iconListCommand \
  1050.         -multiple    $data(-multiple)]
  1051.     bind $data(icons) <<ListboxSelect>> \
  1052.         [list ::tk::dialog::file::ListBrowse $w]
  1053.  
  1054.     # f2: the frame with the OK button, cancel button, "file name" field
  1055.     #     and file types field.
  1056.     #
  1057.     set f2 [frame $w.f2 -bd 0]
  1058.     bind [::tk::AmpWidget label $f2.lab -text $fNameCaption -anchor e -pady 0]\
  1059.         <<AltUnderlined>> [list focus $f2.ent]
  1060.     set data(ent) [entry $f2.ent]
  1061.  
  1062.     # The font to use for the icons. The default Canvas font on Unix
  1063.     # is just deviant.
  1064.     set ::tk::$w.icons(font) [$data(ent) cget -font]
  1065.  
  1066.     # Make the file types bits only if this is a File Dialog
  1067.     if { $class eq "TkFDialog" } {
  1068.     set data(typeMenuLab) [::tk::AmpWidget label $f2.lab2 \
  1069.         -text $fTypeCaption -anchor e -pady [$f2.lab cget -pady]]
  1070.     set data(typeMenuBtn) [menubutton $f2.menu -indicatoron 1 \
  1071.         -menu $f2.menu.m]
  1072.     set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
  1073.     $data(typeMenuBtn) configure -takefocus 1 -highlightthickness 2 \
  1074.         -relief raised -bd 2 -anchor w
  1075.         bind $data(typeMenuLab) <<AltUnderlined>> [list \
  1076.         focus $data(typeMenuBtn)]
  1077.     }
  1078.  
  1079.     # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn
  1080.     # is true.  Create it disabled so the binding doesn't trigger if it
  1081.     # isn't shown.
  1082.     if {$class eq "TkFDialog"} {
  1083.     set text [mc "Show &Hidden Files and Directories"]
  1084.     } else {
  1085.     set text [mc "Show &Hidden Directories"]
  1086.     }
  1087.     set data(hiddenBtn) [::tk::AmpWidget checkbutton $f2.hidden \
  1088.         -text $text -anchor w -padx 3 -state disabled \
  1089.         -variable ::tk::dialog::file::showHiddenVar \
  1090.         -command [list ::tk::dialog::file::UpdateWhenIdle $w]]
  1091.  
  1092.     # the okBtn is created after the typeMenu so that the keyboard traversal
  1093.     # is in the right order, and add binding so that we find out when the
  1094.     # dialog is destroyed by the user (added here instead of to the overall
  1095.     # window so no confusion about how much <Destroy> gets called; exactly
  1096.     # once will do). [Bug 987169]
  1097.  
  1098.     set data(okBtn)     [::tk::AmpWidget button $f2.ok \
  1099.         -text [mc "&OK"]     -default active -pady 3]
  1100.     bind $data(okBtn) <Destroy> [list ::tk::dialog::file::Destroyed $w]
  1101.     set data(cancelBtn) [::tk::AmpWidget button $f2.cancel \
  1102.         -text [mc "&Cancel"] -default normal -pady 3]
  1103.  
  1104.     # grid the widgets in f2
  1105.     #
  1106.     grid $f2.lab $f2.ent $data(okBtn) -padx 4 -sticky ew
  1107.     grid configure $f2.ent -padx 2
  1108.     if { $class eq "TkFDialog" } {
  1109.     grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \
  1110.         -padx 4 -sticky ew
  1111.     grid configure $data(typeMenuBtn) -padx 0
  1112.     grid $data(hiddenBtn) -columnspan 2 -padx 4 -sticky ew
  1113.     } else {
  1114.     grid $data(hiddenBtn) - $data(cancelBtn) -padx 4 -sticky ew
  1115.     }
  1116.     grid columnconfigure $f2 1 -weight 1
  1117.  
  1118.     # Pack all the frames together. We are done with widget construction.
  1119.     #
  1120.     pack $f1 -side top -fill x -pady 4
  1121.     pack $f2 -side bottom -fill x
  1122.     pack $data(icons) -expand yes -fill both -padx 4 -pady 1
  1123.  
  1124.     # Set up the event handlers that are common to Directory and File Dialogs
  1125.     #
  1126.  
  1127.     wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]
  1128.     $data(upBtn)     configure -command [list ::tk::dialog::file::UpDirCmd $w]
  1129.     $data(cancelBtn) configure -command [list ::tk::dialog::file::CancelCmd $w]
  1130.     bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
  1131.     bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
  1132.  
  1133.     # Set up event handlers specific to File or Directory Dialogs
  1134.     #
  1135.     if { $class eq "TkFDialog" } {
  1136.     bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]
  1137.     $data(okBtn)     configure -command [list ::tk::dialog::file::OkCmd $w]
  1138.     bind $w <Alt-t> [format {
  1139.         if {[%s cget -state] eq "normal"} {
  1140.         focus %s
  1141.         }
  1142.     } $data(typeMenuBtn) $data(typeMenuBtn)]
  1143.     } else {
  1144.     set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]
  1145.     bind $data(ent) <Return> $okCmd
  1146.     $data(okBtn) configure -command $okCmd
  1147.     bind $w <Alt-s> [list focus $data(ent)]
  1148.     bind $w <Alt-o> [list tk::ButtonInvoke $data(okBtn)]
  1149.     }
  1150.     bind $w <Alt-h> [list $data(hiddenBtn) invoke]
  1151.  
  1152.     # Build the focus group for all the entries
  1153.     #
  1154.     ::tk::FocusGroup_Create $w
  1155.     ::tk::FocusGroup_BindIn $w  $data(ent) [list ::tk::dialog::file::EntFocusIn $w]
  1156.     ::tk::FocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w]
  1157. }
  1158.  
  1159. # ::tk::dialog::file::SetSelectMode --
  1160. #
  1161. #    Set the select mode of the dialog to single select or multi-select.
  1162. #
  1163. # Arguments:
  1164. #    w        The dialog path.
  1165. #    multi        1 if the dialog is multi-select; 0 otherwise.
  1166. #
  1167. # Results:
  1168. #    None.
  1169.  
  1170. proc ::tk::dialog::file::SetSelectMode {w multi} {
  1171.     set dataName __tk_filedialog
  1172.     upvar ::tk::dialog::file::$dataName data
  1173.     if { $multi } {
  1174.     set fNameCaption "[mc {File &names:}]"
  1175.     } else {
  1176.     set fNameCaption "[mc {File &name:}]"
  1177.     }
  1178.     set iconListCommand [list ::tk::dialog::file::OkCmd $w]
  1179.     ::tk::SetAmpText $w.f2.lab $fNameCaption 
  1180.     ::tk::IconList_Config $data(icons) \
  1181.         [list -multiple $multi -command $iconListCommand]
  1182.     return
  1183. }
  1184.  
  1185. # ::tk::dialog::file::UpdateWhenIdle --
  1186. #
  1187. #    Creates an idle event handler which updates the dialog in idle
  1188. #    time. This is important because loading the directory may take a long
  1189. #    time and we don't want to load the same directory for multiple times
  1190. #    due to multiple concurrent events.
  1191. #
  1192. proc ::tk::dialog::file::UpdateWhenIdle {w} {
  1193.     upvar ::tk::dialog::file::[winfo name $w] data
  1194.  
  1195.     if {[info exists data(updateId)]} {
  1196.     return
  1197.     } else {
  1198.     set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
  1199.     }
  1200. }
  1201.  
  1202. # ::tk::dialog::file::Update --
  1203. #
  1204. #    Loads the files and directories into the IconList widget. Also
  1205. #    sets up the directory option menu for quick access to parent
  1206. #    directories.
  1207. #
  1208. proc ::tk::dialog::file::Update {w} {
  1209.  
  1210.     # This proc may be called within an idle handler. Make sure that the
  1211.     # window has not been destroyed before this proc is called
  1212.     if {![winfo exists $w]} {
  1213.     return
  1214.     }
  1215.     set class [winfo class $w]
  1216.     if {($class ne "TkFDialog") && ($class ne "TkChooseDir")} {
  1217.     return
  1218.     }
  1219.  
  1220.     set dataName [winfo name $w]
  1221.     upvar ::tk::dialog::file::$dataName data
  1222.     variable ::tk::Priv
  1223.     global tk_library
  1224.     unset -nocomplain data(updateId)
  1225.  
  1226.     if {![info exists Priv(folderImage)]} {
  1227.     set Priv(folderImage) [image create photo -data {
  1228. R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
  1229. QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
  1230.     set Priv(fileImage)   [image create photo -data {
  1231. R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
  1232. rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
  1233.     }
  1234.     set folder $Priv(folderImage)
  1235.     set file   $Priv(fileImage)
  1236.  
  1237.     set appPWD [pwd]
  1238.     if {[catch {
  1239.     cd $data(selectPath)
  1240.     }]} {
  1241.     # We cannot change directory to $data(selectPath). $data(selectPath)
  1242.     # should have been checked before ::tk::dialog::file::Update is called, so
  1243.     # we normally won't come to here. Anyways, give an error and abort
  1244.     # action.
  1245.     tk_messageBox -type ok -parent $w -icon warning -message \
  1246.         [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)]
  1247.     cd $appPWD
  1248.     return
  1249.     }
  1250.  
  1251.     # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
  1252.     # so the user may still click and cause havoc ...
  1253.     #
  1254.     set entCursor [$data(ent) cget -cursor]
  1255.     set dlgCursor [$w         cget -cursor]
  1256.     $data(ent) configure -cursor watch
  1257.     $w         configure -cursor watch
  1258.     update idletasks
  1259.  
  1260.     ::tk::IconList_DeleteAll $data(icons)
  1261.  
  1262.     set showHidden $::tk::dialog::file::showHiddenVar
  1263.  
  1264.     # Make the dir list
  1265.     # Using -directory [pwd] is better in some VFS cases.
  1266.     set cmd [list glob -tails -directory [pwd] -type d -nocomplain *]
  1267.     if {$showHidden} { lappend cmd .* }
  1268.     set dirs [lsort -dictionary -unique [eval $cmd]]
  1269.     set dirList {}
  1270.     foreach d $dirs {
  1271.     if {$d eq "." || $d eq ".."} {
  1272.         continue
  1273.     }
  1274.     lappend dirList $d
  1275.     }
  1276.     ::tk::IconList_Add $data(icons) $folder $dirList
  1277.  
  1278.     if {$class eq "TkFDialog"} {
  1279.     # Make the file list if this is a File Dialog, selecting all
  1280.     # but 'd'irectory type files.
  1281.     #
  1282.     set cmd [list glob -tails -directory [pwd] \
  1283.              -type {f b c l p s} -nocomplain]
  1284.     if {$data(filter) eq "*"} {
  1285.         lappend cmd *
  1286.         if {$showHidden} { lappend cmd .* }
  1287.     } else {
  1288.         eval [list lappend cmd] $data(filter)
  1289.     }
  1290.     set fileList [lsort -dictionary -unique [eval $cmd]]
  1291.     ::tk::IconList_Add $data(icons) $file $fileList
  1292.     }
  1293.  
  1294.     ::tk::IconList_Arrange $data(icons)
  1295.  
  1296.     # Update the Directory: option menu
  1297.     #
  1298.     set list ""
  1299.     set dir ""
  1300.     foreach subdir [file split $data(selectPath)] {
  1301.     set dir [file join $dir $subdir]
  1302.     lappend list $dir
  1303.     }
  1304.  
  1305.     $data(dirMenu) delete 0 end
  1306.     set var [format %s(selectPath) ::tk::dialog::file::$dataName]
  1307.     foreach path $list {
  1308.     $data(dirMenu) add command -label $path -command [list set $var $path]
  1309.     }
  1310.  
  1311.     # Restore the PWD to the application's PWD
  1312.     #
  1313.     cd $appPWD
  1314.  
  1315.     if { $class eq "TkFDialog" } {
  1316.     # Restore the Open/Save Button if this is a File Dialog
  1317.     #
  1318.     if {$data(type) eq "open"} {
  1319.         ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1320.     } else {
  1321.         ::tk::SetAmpText $data(okBtn) [mc "&Save"]
  1322.     }
  1323.     }
  1324.  
  1325.     # turn off the busy cursor.
  1326.     #
  1327.     $data(ent) configure -cursor $entCursor
  1328.     $w         configure -cursor $dlgCursor
  1329. }
  1330.  
  1331. # ::tk::dialog::file::SetPathSilently --
  1332. #
  1333. #     Sets data(selectPath) without invoking the trace procedure
  1334. #
  1335. proc ::tk::dialog::file::SetPathSilently {w path} {
  1336.     upvar ::tk::dialog::file::[winfo name $w] data
  1337.     
  1338.     trace remove variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
  1339.     set data(selectPath) $path
  1340.     trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
  1341. }
  1342.  
  1343.  
  1344. # This proc gets called whenever data(selectPath) is set
  1345. #
  1346. proc ::tk::dialog::file::SetPath {w name1 name2 op} {
  1347.     if {[winfo exists $w]} {
  1348.     upvar ::tk::dialog::file::[winfo name $w] data
  1349.     ::tk::dialog::file::UpdateWhenIdle $w
  1350.     # On directory dialogs, we keep the entry in sync with the currentdir.
  1351.     if { [winfo class $w] eq "TkChooseDir" } {
  1352.         $data(ent) delete 0 end
  1353.         $data(ent) insert end $data(selectPath)
  1354.     }
  1355.     }
  1356. }
  1357.  
  1358. # This proc gets called whenever data(filter) is set
  1359. #
  1360. proc ::tk::dialog::file::SetFilter {w type} {
  1361.     upvar ::tk::dialog::file::[winfo name $w] data
  1362.     upvar ::tk::$data(icons) icons
  1363.  
  1364.     set data(filter) [lindex $type 1]
  1365.     $data(typeMenuBtn) configure -text [lindex $type 0] -indicatoron 1
  1366.  
  1367.     # If we aren't using a default extension, use the one suppled
  1368.     # by the filter.
  1369.     if {![info exists data(extUsed)]} {
  1370.     if {[string length $data(-defaultextension)]} {
  1371.         set data(extUsed) 1
  1372.     } else {
  1373.         set data(extUsed) 0
  1374.     }
  1375.     }
  1376.  
  1377.     if {!$data(extUsed)} {
  1378.     # Get the first extension in the list that matches {^\*\.\w+$}
  1379.     # and remove all * from the filter.
  1380.     set index [lsearch -regexp $data(filter) {^\*\.\w+$}]
  1381.     if {$index >= 0} {
  1382.         set data(-defaultextension) \
  1383.             [string trimleft [lindex $data(filter) $index] "*"]
  1384.     } else {
  1385.         # Couldn't find anything!  Reset to a safe default...
  1386.         set data(-defaultextension) ""
  1387.     }
  1388.     }
  1389.  
  1390.     $icons(sbar) set 0.0 0.0
  1391.     
  1392.     ::tk::dialog::file::UpdateWhenIdle $w
  1393. }
  1394.  
  1395. # tk::dialog::file::ResolveFile --
  1396. #
  1397. #    Interpret the user's text input in a file selection dialog.
  1398. #    Performs:
  1399. #
  1400. #    (1) ~ substitution
  1401. #    (2) resolve all instances of . and ..
  1402. #    (3) check for non-existent files/directories
  1403. #    (4) check for chdir permissions
  1404. #
  1405. # Arguments:
  1406. #    context:  the current directory you are in
  1407. #    text:      the text entered by the user
  1408. #    defaultext: the default extension to add to files with no extension
  1409. #
  1410. # Return vaue:
  1411. #    [list $flag $directory $file]
  1412. #
  1413. #     flag = OK    : valid input
  1414. #          = PATTERN    : valid directory/pattern
  1415. #          = PATH    : the directory does not exist
  1416. #          = FILE    : the directory exists by the file doesn't
  1417. #              exist
  1418. #          = CHDIR    : Cannot change to the directory
  1419. #          = ERROR    : Invalid entry
  1420. #
  1421. #     directory      : valid only if flag = OK or PATTERN or FILE
  1422. #     file           : valid only if flag = OK or PATTERN
  1423. #
  1424. #    directory may not be the same as context, because text may contain
  1425. #    a subdirectory name
  1426. #
  1427. proc ::tk::dialog::file::ResolveFile {context text defaultext} {
  1428.  
  1429.     set appPWD [pwd]
  1430.  
  1431.     set path [::tk::dialog::file::JoinFile $context $text]
  1432.  
  1433.     # If the file has no extension, append the default.  Be careful not
  1434.     # to do this for directories, otherwise typing a dirname in the box
  1435.     # will give back "dirname.extension" instead of trying to change dir.
  1436.     if {![file isdirectory $path] && [file ext $path] eq ""} {
  1437.     set path "$path$defaultext"
  1438.     }
  1439.  
  1440.  
  1441.     if {[catch {file exists $path}]} {
  1442.     # This "if" block can be safely removed if the following code
  1443.     # stop generating errors.
  1444.     #
  1445.     #    file exists ~nonsuchuser
  1446.     #
  1447.     return [list ERROR $path ""]
  1448.     }
  1449.  
  1450.     if {[file exists $path]} {
  1451.     if {[file isdirectory $path]} {
  1452.         if {[catch {cd $path}]} {
  1453.         return [list CHDIR $path ""]
  1454.         }
  1455.         set directory [pwd]
  1456.         set file ""
  1457.         set flag OK
  1458.         cd $appPWD
  1459.     } else {
  1460.         if {[catch {cd [file dirname $path]}]} {
  1461.         return [list CHDIR [file dirname $path] ""]
  1462.         }
  1463.         set directory [pwd]
  1464.         set file [file tail $path]
  1465.         set flag OK
  1466.         cd $appPWD
  1467.     }
  1468.     } else {
  1469.     set dirname [file dirname $path]
  1470.     if {[file exists $dirname]} {
  1471.         if {[catch {cd $dirname}]} {
  1472.         return [list CHDIR $dirname ""]
  1473.         }
  1474.         set directory [pwd]
  1475.         set file [file tail $path]
  1476.         if {[regexp {[*]|[?]} $file]} {
  1477.         set flag PATTERN
  1478.         } else {
  1479.         set flag FILE
  1480.         }
  1481.         cd $appPWD
  1482.     } else {
  1483.         set directory $dirname
  1484.         set file [file tail $path]
  1485.         set flag PATH
  1486.     }
  1487.     }
  1488.  
  1489.     return [list $flag $directory $file]
  1490. }
  1491.  
  1492.  
  1493. # Gets called when the entry box gets keyboard focus. We clear the selection
  1494. # from the icon list . This way the user can be certain that the input in the 
  1495. # entry box is the selection.
  1496. #
  1497. proc ::tk::dialog::file::EntFocusIn {w} {
  1498.     upvar ::tk::dialog::file::[winfo name $w] data
  1499.  
  1500.     if {[$data(ent) get] ne ""} {
  1501.     $data(ent) selection range 0 end
  1502.     $data(ent) icursor end
  1503.     } else {
  1504.     $data(ent) selection clear
  1505.     }
  1506.  
  1507.     if { [winfo class $w] eq "TkFDialog" } {
  1508.     # If this is a File Dialog, make sure the buttons are labeled right.
  1509.     if {$data(type) eq "open"} {
  1510.         ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1511.     } else {
  1512.         ::tk::SetAmpText $data(okBtn) [mc "&Save"]
  1513.     }
  1514.     }
  1515. }
  1516.  
  1517. proc ::tk::dialog::file::EntFocusOut {w} {
  1518.     upvar ::tk::dialog::file::[winfo name $w] data
  1519.  
  1520.     $data(ent) selection clear
  1521. }
  1522.  
  1523.  
  1524. # Gets called when user presses Return in the "File name" entry.
  1525. #
  1526. proc ::tk::dialog::file::ActivateEnt {w} {
  1527.     upvar ::tk::dialog::file::[winfo name $w] data
  1528.  
  1529.     set text [$data(ent) get]
  1530.     if {$data(-multiple)} {
  1531.     # For the multiple case we have to be careful to get the file
  1532.     # names as a true list, watching out for a single file with a
  1533.     # space in the name.  Thus we query the IconList directly.
  1534.  
  1535.     set selIcos [::tk::IconList_Curselection $data(icons)]
  1536.     set data(selectFile) ""
  1537.     if {[llength $selIcos] == 0 && $text ne ""} {
  1538.         # This assumes the user typed something in without selecting
  1539.         # files - so assume they only type in a single filename.
  1540.         ::tk::dialog::file::VerifyFileName $w $text
  1541.     } else {
  1542.         foreach item $selIcos {
  1543.         ::tk::dialog::file::VerifyFileName $w \
  1544.             [::tk::IconList_Get $data(icons) $item]
  1545.         }
  1546.     }
  1547.     } else {
  1548.     ::tk::dialog::file::VerifyFileName $w $text
  1549.     }
  1550. }
  1551.  
  1552. # Verification procedure
  1553. #
  1554. proc ::tk::dialog::file::VerifyFileName {w filename} {
  1555.     upvar ::tk::dialog::file::[winfo name $w] data
  1556.  
  1557.     set list [::tk::dialog::file::ResolveFile $data(selectPath) $filename \
  1558.         $data(-defaultextension)]
  1559.     foreach {flag path file} $list {
  1560.     break
  1561.     }
  1562.  
  1563.     switch -- $flag {
  1564.     OK {
  1565.         if {$file eq ""} {
  1566.         # user has entered an existing (sub)directory
  1567.         set data(selectPath) $path
  1568.         $data(ent) delete 0 end
  1569.         } else {
  1570.         ::tk::dialog::file::SetPathSilently $w $path
  1571.         if {$data(-multiple)} {
  1572.             lappend data(selectFile) $file
  1573.         } else {
  1574.             set data(selectFile) $file
  1575.         }
  1576.         ::tk::dialog::file::Done $w
  1577.         }
  1578.     }
  1579.     PATTERN {
  1580.         set data(selectPath) $path
  1581.         set data(filter) $file
  1582.     }
  1583.     FILE {
  1584.         if {$data(type) eq "open"} {
  1585.         tk_messageBox -icon warning -type ok -parent $w \
  1586.             -message "[mc "File \"%1\$s\"  does not exist." [file join $path $file]]"
  1587.         $data(ent) selection range 0 end
  1588.         $data(ent) icursor end
  1589.         } else {
  1590.         ::tk::dialog::file::SetPathSilently $w $path
  1591.         if {$data(-multiple)} {
  1592.             lappend data(selectFile) $file
  1593.         } else {
  1594.             set data(selectFile) $file
  1595.         }
  1596.         ::tk::dialog::file::Done $w
  1597.         }
  1598.     }
  1599.     PATH {
  1600.         tk_messageBox -icon warning -type ok -parent $w \
  1601.         -message "[mc "Directory \"%1\$s\" does not exist." $path]"
  1602.         $data(ent) selection range 0 end
  1603.         $data(ent) icursor end
  1604.     }
  1605.     CHDIR {
  1606.         tk_messageBox -type ok -parent $w -message \
  1607.            "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $path]"\
  1608.         -icon warning
  1609.         $data(ent) selection range 0 end
  1610.         $data(ent) icursor end
  1611.     }
  1612.     ERROR {
  1613.         tk_messageBox -type ok -parent $w -message \
  1614.            "[mc "Invalid file name \"%1\$s\"." $path]"\
  1615.         -icon warning
  1616.         $data(ent) selection range 0 end
  1617.         $data(ent) icursor end
  1618.     }
  1619.     }
  1620. }
  1621.  
  1622. # Gets called when user presses the Alt-s or Alt-o keys.
  1623. #
  1624. proc ::tk::dialog::file::InvokeBtn {w key} {
  1625.     upvar ::tk::dialog::file::[winfo name $w] data
  1626.  
  1627.     if {[$data(okBtn) cget -text] eq $key} {
  1628.     ::tk::ButtonInvoke $data(okBtn)
  1629.     }
  1630. }
  1631.  
  1632. # Gets called when user presses the "parent directory" button
  1633. #
  1634. proc ::tk::dialog::file::UpDirCmd {w} {
  1635.     upvar ::tk::dialog::file::[winfo name $w] data
  1636.  
  1637.     if {$data(selectPath) ne "/"} {
  1638.     set data(selectPath) [file dirname $data(selectPath)]
  1639.     }
  1640. }
  1641.  
  1642. # Join a file name to a path name. The "file join" command will break
  1643. # if the filename begins with ~
  1644. #
  1645. proc ::tk::dialog::file::JoinFile {path file} {
  1646.     if {[string match {~*} $file] && [file exists $path/$file]} {
  1647.     return [file join $path ./$file]
  1648.     } else {
  1649.     return [file join $path $file]
  1650.     }
  1651. }
  1652.  
  1653. # Gets called when user presses the "OK" button
  1654. #
  1655. proc ::tk::dialog::file::OkCmd {w} {
  1656.     upvar ::tk::dialog::file::[winfo name $w] data
  1657.  
  1658.     set filenames {}
  1659.     foreach item [::tk::IconList_Curselection $data(icons)] {
  1660.     lappend filenames [::tk::IconList_Get $data(icons) $item]
  1661.     }
  1662.  
  1663.     if {([llength $filenames] && !$data(-multiple)) || \
  1664.         ($data(-multiple) && ([llength $filenames] == 1))} {
  1665.     set filename [lindex $filenames 0]
  1666.     set file [::tk::dialog::file::JoinFile $data(selectPath) $filename]
  1667.     if {[file isdirectory $file]} {
  1668.         ::tk::dialog::file::ListInvoke $w [list $filename]
  1669.         return
  1670.     }
  1671.     }
  1672.  
  1673.     ::tk::dialog::file::ActivateEnt $w
  1674. }
  1675.  
  1676. # Gets called when user presses the "Cancel" button
  1677. #
  1678. proc ::tk::dialog::file::CancelCmd {w} {
  1679.     upvar ::tk::dialog::file::[winfo name $w] data
  1680.     variable ::tk::Priv
  1681.  
  1682.     bind $data(okBtn) <Destroy> {}
  1683.     set Priv(selectFilePath) ""
  1684. }
  1685.  
  1686. # Gets called when user destroys the dialog directly [Bug 987169]
  1687. #
  1688. proc ::tk::dialog::file::Destroyed {w} {
  1689.     upvar ::tk::dialog::file::[winfo name $w] data
  1690.     variable ::tk::Priv
  1691.  
  1692.     set Priv(selectFilePath) ""
  1693. }
  1694.  
  1695. # Gets called when user browses the IconList widget (dragging mouse, arrow
  1696. # keys, etc)
  1697. #
  1698. proc ::tk::dialog::file::ListBrowse {w} {
  1699.     upvar ::tk::dialog::file::[winfo name $w] data
  1700.  
  1701.     set text {}
  1702.     foreach item [::tk::IconList_Curselection $data(icons)] {
  1703.     lappend text [::tk::IconList_Get $data(icons) $item]
  1704.     }
  1705.     if {[llength $text] == 0} {
  1706.     return
  1707.     }
  1708.     if { [llength $text] > 1 } {
  1709.     set newtext {}
  1710.     foreach file $text {
  1711.         set fullfile [::tk::dialog::file::JoinFile $data(selectPath) $file]
  1712.         if { ![file isdirectory $fullfile] } {
  1713.         lappend newtext $file
  1714.         }
  1715.     }
  1716.     set text $newtext
  1717.     set isDir 0
  1718.     } else {
  1719.     set text [lindex $text 0]
  1720.     set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
  1721.     set isDir [file isdirectory $file]
  1722.     }
  1723.     if {!$isDir} {
  1724.     $data(ent) delete 0 end
  1725.     $data(ent) insert 0 $text
  1726.  
  1727.     if { [winfo class $w] eq "TkFDialog" } {
  1728.         if {$data(type) eq "open"} {
  1729.         ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1730.         } else {
  1731.         ::tk::SetAmpText $data(okBtn) [mc "&Save"]
  1732.         }
  1733.     }
  1734.     } else {
  1735.     if { [winfo class $w] eq "TkFDialog" } {
  1736.         ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1737.     }
  1738.     }
  1739. }
  1740.  
  1741. # Gets called when user invokes the IconList widget (double-click, 
  1742. # Return key, etc)
  1743. #
  1744. proc ::tk::dialog::file::ListInvoke {w filenames} {
  1745.     upvar ::tk::dialog::file::[winfo name $w] data
  1746.  
  1747.     if {[llength $filenames] == 0} {
  1748.     return
  1749.     }
  1750.  
  1751.     set file [::tk::dialog::file::JoinFile $data(selectPath) \
  1752.         [lindex $filenames 0]]
  1753.     
  1754.     set class [winfo class $w]
  1755.     if {$class eq "TkChooseDir" || [file isdirectory $file]} {
  1756.     set appPWD [pwd]
  1757.     if {[catch {cd $file}]} {
  1758.         tk_messageBox -type ok -parent $w -message \
  1759.            "[mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $file]"\
  1760.         -icon warning
  1761.     } else {
  1762.         cd $appPWD
  1763.         set data(selectPath) $file
  1764.     }
  1765.     } else {
  1766.     if {$data(-multiple)} {
  1767.         set data(selectFile) $filenames
  1768.     } else {
  1769.         set data(selectFile) $file
  1770.     }
  1771.     ::tk::dialog::file::Done $w
  1772.     }
  1773. }
  1774.  
  1775. # ::tk::dialog::file::Done --
  1776. #
  1777. #    Gets called when user has input a valid filename.  Pops up a
  1778. #    dialog box to confirm selection when necessary. Sets the
  1779. #    tk::Priv(selectFilePath) variable, which will break the "vwait"
  1780. #    loop in ::tk::dialog::file:: and return the selected filename to the
  1781. #    script that calls tk_getOpenFile or tk_getSaveFile
  1782. #
  1783. proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
  1784.     upvar ::tk::dialog::file::[winfo name $w] data
  1785.     variable ::tk::Priv
  1786.  
  1787.     if {$selectFilePath eq ""} {
  1788.     if {$data(-multiple)} {
  1789.         set selectFilePath {}
  1790.         foreach f $data(selectFile) {
  1791.         lappend selectFilePath [::tk::dialog::file::JoinFile \
  1792.             $data(selectPath) $f]
  1793.         }
  1794.     } else {
  1795.         set selectFilePath [::tk::dialog::file::JoinFile \
  1796.             $data(selectPath) $data(selectFile)]
  1797.     }
  1798.     
  1799.     set Priv(selectFile)     $data(selectFile)
  1800.     set Priv(selectPath)     $data(selectPath)
  1801.  
  1802.     if {$data(type) eq "save"} {
  1803.         if {[file exists $selectFilePath]} {
  1804.         set reply [tk_messageBox -icon warning -type yesno\
  1805.             -parent $w -message \
  1806.             "[mc "File \"%1\$s\" already exists.\nDo you want to overwrite it?" $selectFilePath]"]
  1807.         if {$reply eq "no"} {
  1808.         return
  1809.         }
  1810.         }
  1811.     }
  1812.     }
  1813.     bind $data(okBtn) <Destroy> {}
  1814.     set Priv(selectFilePath) $selectFilePath
  1815. }
  1816.